home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagd_f.zip / DOS.SWG / 0021_Dos Environment Unit.pas < prev    next >
Pascal/Delphi Source File  |  1993-08-27  |  5KB  |  196 lines
  1. {
  2. Subject: Enviro.pas Unit to change Dos Vars permanently
  3.  
  4.  
  5. Had this floating round, hope it helps someone.
  6. It works under Dos 5, NDos 6.01, and should work For any other Dos as well,
  7. no guarantees tho' .
  8.  
  9. }
  10. Unit Enviro;
  11.  
  12. Interface
  13.  
  14. Var EnvSeg,
  15.     EnvOfs,
  16.     EnvSize  :  Word;
  17.  
  18. Function  FindEnv:Boolean;
  19. Function  IsEnvVar(Variable : String;Var Value : String):Boolean;
  20. Procedure ChangeEnvVar(Variable,NewVal : String);
  21.  
  22. Implementation
  23.  
  24. Uses Dos;
  25.  
  26. Type MemoryControlBlock =     {MCB -- only needed fields are shown}
  27.       Record
  28.         Blocktag   :  Byte;
  29.         BlockOwner :  Word;
  30.         BlockSize  :  Word;
  31.         misc       :  Array[1..3] of Byte;
  32.         ProgramName:  Array[1..8] of Char;
  33.       end;
  34.  
  35.     ProgramSegmentPrefix =   {PSP -- only needed fields are shown}
  36.       Record                                           { offset }
  37.         PSPtag     :  Word;  { $20CD or $27CD if PSP}  { 00 $00 }
  38.         misc       :  Array[1..21] of Word;            { 02 $02 }
  39.         Environment:  Word                             { 44 $2C }
  40.       end;
  41.  
  42. Var
  43.   MCB      : ^MemoryControlBlock;
  44.   r        : Registers;
  45.   Found    : Boolean;
  46.   SegMent  : Word;
  47.   EnvPtr   : Word;
  48.   Startofs : Word;
  49.  
  50. Function FindEnvMCB:Boolean;
  51. Var
  52.   b        :  Char;
  53.   BlockType:  String[12];
  54.   Bytes    :  LongInt;
  55.   i        :  Word;
  56.   last     :  Char;
  57.   MCBenv   :  ^MemoryControlBlock;
  58.   MCBowner :  ^MemoryControlBlock;
  59.   psp      :  ^ProgramSegmentPrefix;
  60.  
  61. begin
  62. FindEnvMCB := False;
  63.  
  64. Bytes := LongInt(MCB^.BlockSize) SHL 4;    {size of MCB in Bytes}
  65. if mcb^.blockowner = 0 then                { free space }
  66. else begin
  67.   psp := Ptr(MCB^.BlockOwner,0);            {possible PSP}
  68.   if   (psp^.PSPtag = $20CD) or (psp^.PSPtag = $27CD) then begin
  69.   MCBenv := Ptr(psp^.Environment-1,0);
  70.   if   MCB^.Blockowner <> (segment + 1) then
  71.     if psp^.Environment = (segment + 1) then
  72.       if  MCB^.BlockOwner = MCBenv^.BlockOwner then begin
  73.          EnvSize := MCBenv^.BlockSize SHL 4;      {multiply by 16}
  74.          EnvSeg := PSP^.Environment;
  75.          EnvOfs := 0;
  76.          FindEnvMCB := True;
  77.          end
  78.     end
  79.   end;
  80. end;
  81.  
  82. Function FindEnv:Boolean;
  83. begin
  84. r.AH := $52;            {undocumented Dos Function that returns a Pointer}
  85. Intr ($21,r);           {to the Dos 'list of lists'                      }
  86. segment := MemW[r.ES:r.BX-2];  {segment address of first MCB found at}
  87.                                {offset -2 from List of List Pointer  }
  88. Repeat
  89. MCB := Ptr(segment,0);    {MCB^ points to first MCB}
  90.   Found := FindEnvMcb;    {Look at each MCB}
  91.   segment := segment + MCB^.BlockSize + 1
  92. Until (Found) or (MCB^.Blocktag = $5A);
  93. FindEnv := Found;
  94. end;
  95.  
  96. Function IsEnvVar(Variable : String;Var Value : String):Boolean;
  97. Var Temp : String;
  98.     ch   : Char;
  99.     i    : Word;
  100.     FoundIt : Boolean;
  101. begin
  102. Variable := Variable + '=';
  103. FoundIt := False;
  104. i := EnvOfs;
  105. Repeat
  106.   Temp := '';
  107.   StartOfs := I;
  108.   Repeat
  109.     ch := Char(Mem[EnvSeg:i]);
  110.     if Ch <> #0 then Temp := Temp + Ch;
  111.     inc(i);
  112.   Until (Ch = #0) or (I > EnvSize);
  113.   if Ch = #0 then begin
  114.     FoundIt := (Pos(Variable,Temp) = 1);
  115.     if FoundIt then Value := Copy(Temp,Length(Variable)+1,255);
  116.     end;
  117. Until (FoundIt) or (I > EnvSize);
  118. IsEnvVar := FoundIt;
  119. end;
  120.  
  121. Procedure ChangeEnvVar(Variable,NewVal : String);
  122. Var OldVal : String;
  123.     p1,p2  : Pointer;
  124.     i,j    : Word;
  125.     ch,
  126.     LastCh : Char;
  127. begin
  128. if IsEnvVar(Variable,OldVal) then begin
  129.   p1 := Ptr(EnvSeg,StartOfs + Length(Variable)+1);
  130.   if Length(OldVal) = Length(NewVal) then
  131.      Move(NewVal[1],p1^,Length(NewVal))
  132.   else if Length(OldVal) > Length(NewVal) then begin
  133.      Move(NewVal[1],p1^,Length(NewVal));
  134.      p1 := ptr(EnvSeg,StartOfs + Length(Variable)+Length(OldVal)+1);
  135.      p2 := ptr(EnvSeg,StartOfs + Length(Variable)+Length(NewVal)+1);
  136.      Move(p1^,p2^,EnvSize - ofs(p1^));
  137.      end
  138.   else begin   { newVar is longer than oldVar }
  139.      p2 := ptr(EnvSeg,StartOfs + Length(Variable)+Length(NewVal)-length(OldVal)+1);
  140.      Move(p1^,p2^,EnvSize - ofs(p2^));
  141.      Move(NewVal[1],p1^,Length(NewVal));
  142.      end;
  143.   end
  144. else      { creating a new Var }
  145.   begin
  146.   i := EnvOfs;
  147.   ch := Char(Mem[EnvSeg:i]);
  148.   Repeat
  149.     LastCh := Ch;
  150.     inc(i);
  151.     ch := Char(Mem[EnvSeg:i]);
  152.   Until (i > EnvSize) or ((LastCh = #0) and (Ch = #0));
  153.   if i < EnvSize then begin
  154.     j := 1;
  155.     Variable := Variable + '=' + NewVal + #0 + #0;
  156.     While (J < Length(Variable)) and (I <= EnvSize) do begin
  157.       Mem[EnvSeg:i] := ord(Variable[j]);
  158.       inc(i); Inc(j);
  159.       end;
  160.     end;
  161.   end;
  162. end;
  163.  
  164. begin
  165. end.
  166.  
  167. { TEST Program }
  168. Uses Enviro;
  169.  
  170. Var EnvVar : String;
  171.  
  172. begin
  173. if FindEnv then begin
  174.   Writeln('Found the Enviroment !!');
  175.   Writeln('Env is at address ',EnvSeg,':',EnvOfs);
  176.   Writeln('And is ',EnvSize,' Bytes long');
  177.  
  178.   if IsEnvVar('COMSPEC',EnvVar) then Writeln('COMSPEC = ',EnvVar)
  179.   else Writeln('COMSPEC is not set');
  180.  
  181.   if IsEnvVar('NewVar',EnvVar) then  Writeln('NewVar = ',EnvVar)
  182.   else Writeln('NewVar is not set');
  183.  
  184.   ChangeEnvVar('NewVar','This is a new Var');
  185.  
  186.   if IsEnvVar('NewVar',EnvVar) then  Writeln('NewVar = ',EnvVar)
  187.   else Writeln('NewVar is not set');
  188.  
  189.   ChangeEnvVar('NewVar','NewVar is now this');
  190.  
  191.   if IsEnvVar('NewVar',EnvVar) then  Writeln('NewVar = ',EnvVar)
  192.   else Writeln('NewVar is not set');
  193.  
  194.   end;
  195. end.
  196.